Необходимые библиотеки — Кластерный анализ
Сегодня мы работаем преимущественно с igraph в первой
части пары, все необходимое у вас уже должно быть установлено.
library(igraph)
library(intergraph)
Кластеры и сообщества
Сеть с явными сообществами
Подробно почитать об алгоритмах, которыми мы сегодня пользуемся, можно здесь: ссылка 1, ссылка 2
Создание примера сети
set.seed(123)
g = sample_islands(3, 10, 0.8, 3) # 3 группы по 10 узлов
plot(g, vertex.size = 8, vertex.label = NA,
main = "Пример сети с сообществами")
Алгоритм Louvain (самый популярный)
louvain_comm = cluster_louvain(g)
Результаты
kable(paste("Количество сообществ:", length(louvain_comm)))
| x |
|---|
| Количество сообществ: 3 |
kable(paste("Модулярность:", round(modularity(louvain_comm), 3)))
| x |
|---|
| Модулярность: 0.592 |
Размеры сообществ
table(membership(louvain_comm)) %>% kable()
| Var1 | Freq |
|---|---|
| 1 | 10 |
| 2 | 10 |
| 3 | 10 |
Визуализация
plot(louvain_comm, g,
vertex.size = 8,
vertex.label = NA,
main = "Louvain algorithm")
Алгоритм Girvan-Newman (на основе меры посредничества)
gn_comm = cluster_edge_betweenness(g)
kable(paste("Количество сообществ:", length(gn_comm)))
| x |
|---|
| Количество сообществ: 3 |
kable(paste("Модулярность:", round(modularity(gn_comm), 3)))
| x |
|---|
| Модулярность: 0.592 |
plot(gn_comm, g,
vertex.size = 8,
vertex.label = NA,
main = "Girvan-Newman algorithm")
Другие алгоритмы детекции сообществ
Fast greedy (быстрый, хорош для больших сетей)
fg_comm = cluster_fast_greedy(g)
Walktrap (случайные блуждания)
wt_comm = cluster_walktrap(g)
Label propagation (очень быстрый)
lp_comm = cluster_label_prop(g)
Infomap
im_comm = cluster_infomap(g)
Сравнение модулярности
data.frame(
Algorithm = c("Louvain", "Girvan-Newman", "Fast Greedy",
"Walktrap", "Label Prop", "Infomap"),
Modularity = c(
modularity(louvain_comm),
modularity(gn_comm),
modularity(fg_comm),
modularity(wt_comm),
modularity(lp_comm),
modularity(im_comm)
),
Communities = c(
length(louvain_comm),
length(gn_comm),
length(fg_comm),
length(wt_comm),
length(lp_comm),
length(im_comm)
)
) %>% arrange(-Modularity) %>% kable()
| Algorithm | Modularity | Communities |
|---|---|---|
| Louvain | 0.5919678 | 3 |
| Fast Greedy | 0.5919678 | 3 |
| Walktrap | 0.5919678 | 3 |
| Girvan-Newman | 0.5919678 | 3 |
| Label Prop | 0.5919678 | 3 |
| Infomap | 0.5919678 | 3 |
Интерпретация результатов
Получаем членство в сообществах
memb = membership(louvain_comm)
Анализ связей между сообществами
crossing_edges = crossing(louvain_comm, g)
kable(paste("Рёбер между сообществами:", sum(crossing_edges)))
kable(paste("Рёбер внутри сообществ:", sum(!crossing_edges)))
| x |
|---|
| Рёбер между сообществами: 9 |
| x |
|---|
| Рёбер внутри сообществ: 112 |
Матрица связей между сообществами
comm_matrix = table(
Community_From = memb[get.edgelist(g)[,1]],
Community_To = memb[get.edgelist(g)[,2]]
)
kable(comm_matrix)
| 1 | 2 | 3 |
|---|---|---|
| 36 | 3 | 3 |
| 0 | 37 | 3 |
| 0 | 0 | 39 |
Реальные данные (is Russia European after all?)
Вчитываем и конвертируем
load("introToSNAinR.Rdata")
gf = asIgraph(contig_1993)
Сравниваем разные методы
Кластеризация с помощью шести алгоритмов
louvain_comm_m = cluster_louvain(gf)
gn_comm_m = cluster_edge_betweenness(gf)
fg_comm_m = cluster_fast_greedy(gf)
wt_comm_m = cluster_walktrap(gf)
lp_comm_m = cluster_label_prop(gf)
im_comm_m = cluster_infomap(gf)
Сравнительная таблица (более краткий синтаксис)
comm_algorithms = list(Louvain = louvain_comm_m, "Girvan-Newman" = gn_comm_m, "Fast Greedy" = fg_comm_m,
Walktrap = wt_comm_m, "Label Prop" = lp_comm_m, Infomap = im_comm_m)
data.frame(
Modularity = sapply(comm_algorithms, modularity),
Communities = sapply(comm_algorithms, length)
) %>%
arrange(-Modularity)
| Modularity | Communities | |
|---|---|---|
| Louvain | 0.7403351 | 13 |
| Girvan-Newman | 0.7335949 | 13 |
| Walktrap | 0.7173705 | 18 |
| Infomap | 0.7109249 | 21 |
| Fast Greedy | 0.6891824 | 10 |
| Label Prop | 0.6813779 | 21 |
Интерпретация результатов
Получаем членство в сообществах
memb_m = membership(louvain_comm_m)
Кто где находится?
V(gf)$community = memb_m
data.frame(country = V(gf)$State.Abb, community = V(gf)$community) %>%
group_by(community) %>%
summarise(n_states = n(),
states = paste(country, collapse = ", "))
| community | n_states | states |
|---|---|---|
| 1 | 16 | USA, CAN, BHM, CUB, HAI, DOM, JAM, MEX, BLZ, GUA, HON, SAL, NIC, COS, PAN, COL |
| 2 | 19 | TRI, BAR, DMA, GRN, SLU, SVG, AAB, SKN, VEN, GUY, SUR, ECU, PER, BRA, BOL, PAR, CHL, ARG, URU |
| 3 | 22 | UKG, IRE, NTH, BEL, LUX, FRN, LIE, SWZ, GMY, POL, AUS, CZR, SLO, RUS, EST, LAT, LIT, BLR, FIN, SWD, NOR, DEN |
| 4 | 24 | MNC, SPN, AND, POR, HUN, ITA, SNM, MLT, ALB, MAC, CRO, YUG, BOS, SLV, GRC, BUL, MLD, ROM, UKR, MAA, MOR, ALG, TUN, LIB |
| 5 | 26 | CYP, ARM, GRG, AZE, KEN, SOM, DJI, ETH, ERI, SUD, IRN, TUR, IRQ, EGY, SYR, LEB, JOR, ISR, SAU, YEM, KUW, BAH, QAT, UAE, OMA, PAK |
| 6 | 1 | ICE |
| 7 | 22 | CAP, STP, GNB, EQG, GAM, MLI, SEN, BEN, NIR, CDI, GUI, BFO, LBR, SIE, GHA, TOG, CAO, NIG, GAB, CEN, CHA, CON |
| 8 | 19 | DRC, UGA, TAZ, BUI, RWA, ANG, MZM, ZAM, ZIM, MAW, SAF, NAM, LES, BOT, SWA, MAG, COM, MAS, SEY |
| 9 | 33 | AFG, TKM, TAJ, KYR, UZB, KZK, CHN, MON, TAW, PRK, ROK, JPN, IND, BHU, BNG, MYA, SRI, MAD, NEP, THI, CAM, LAO, DRV, MAL, SIN, BRU, PHI, INS, AUL, PNG, VAN, SOL, FSM |
| 10 | 1 | NEW |
| 11 | 1 | FIJ |
| 12 | 1 | MSI |
| 13 | 1 | WSM |
Анализ связей между сообществами
crossing_edges_m = crossing(louvain_comm_m, gf)
kable(paste("Рёбер между сообществами:", sum(crossing_edges_m)))
kable(paste("Рёбер внутри сообществ:", sum(!crossing_edges_m)))
| x |
|---|
| Рёбер между сообществами: 67 |
| x |
|---|
| Рёбер внутри сообществ: 467 |
Матрица связей
comm_matrix_m = table(
Community_From = memb_m[get.edgelist(gf)[,1]],
Community_To = memb_m[get.edgelist(gf)[,2]]
)
kable(comm_matrix_m)
| 1 | 2 | 3 | 4 | 5 | 7 | 8 | 9 | |
|---|---|---|---|---|---|---|---|---|
| 1 | 41 | 6 | 1 | 0 | 0 | 0 | 0 | 0 |
| 2 | 0 | 55 | 0 | 0 | 0 | 0 | 0 | 0 |
| 3 | 0 | 0 | 75 | 13 | 3 | 0 | 0 | 7 |
| 4 | 0 | 0 | 2 | 55 | 10 | 0 | 0 | 0 |
| 5 | 0 | 0 | 0 | 0 | 82 | 0 | 1 | 5 |
| 7 | 0 | 0 | 0 | 6 | 2 | 48 | 4 | 0 |
| 8 | 0 | 0 | 0 | 0 | 4 | 0 | 41 | 0 |
| 9 | 0 | 0 | 0 | 0 | 3 | 0 | 0 | 70 |
Визуализация с атрибутами
Цвета для сообществ
colors = rainbow(length(louvain_comm_m))
V(gf)$color = colors[memb_m]
Размер узлов по степени
V(gf)$size = degree(gf) / 2
Визуализация
plot(gf,
vertex.label = NA,
edge.arrow.size = 0.3,
main = "Сообщества с размером узлов по степени")
legend("topright",
legend = paste("Сообщество", 1:length(louvain_comm_m)),
col = colors, pch = 19, pt.cex = 2)
Сравнение алгоритмов (визуально)
plot(louvain_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
main = paste("Louvain ( Q =", round(modularity(louvain_comm_m), 2), ")"))
plot(gn_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
main = paste("Girvan-Newman ( Q =", round(modularity(gn_comm_m), 2), ")"))
plot(fg_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
main = paste("Fast Greedy ( Q =", round(modularity(fg_comm_m), 2), ")"))
plot(wt_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
main = paste("Walktrap ( Q =", round(modularity(wt_comm_m), 2), ")"))
plot(lp_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
main = paste("Label Prop ( Q =", round(modularity(lp_comm_m), 2), ")"))
plot(im_comm_m, gf, vertex.size = 4, vertex.label = V(gf)$State.Abb, vertex.label.dist = 0.5,
main = paste("Infomap ( Q =", round(modularity(im_comm_m), 2), ")"))
Необходимые библиотеки и данные — Временные сети
Вторая часть разработана на основе материалов Brey (2018), URL: programminghistorian.org (не спрашивайте, как я нашел файлы) и Klein Schmidt (2021), URL: rpubs.com.
detach("package:igraph", unload = TRUE)
library(network)
library(sna)
#install.packages(c("tsna","ndtv"))
library(tsna)
library(ndtv)
Виньетку по пакету tsna можно найти здесь: https://cran.r-project.org/web/packages/tsna/vignettes/tsna_vignette.html
PHStaticEdges = read.csv("https://programminghistorian.org/assets/temporal-network-analysis-with-r/TNAWR_StaticEdgelist.csv")
PHVertexAttributes = read.csv("https://programminghistorian.org/assets/temporal-network-analysis-with-r/TNAWR_VertexAttributes.csv")
PHDynamicNodes = read.csv("https://programminghistorian.org/assets/temporal-network-analysis-with-r/TNAWR_DynamicNodes.csv")
PHDynamicEdges = read.csv("https://programminghistorian.org/assets/temporal-network-analysis-with-r/TNAWR_DynamicEdges.csv")
Анализ временных (динамических, темпоральных) сетей
Статичная сеть
thenetwork = network(PHStaticEdges,
vertex.attr = PHVertexAttributes,
vertex.attrnames = c("vertex.id", "name", "region"),
directed = FALSE,
bipartite = FALSE,
multiple = TRUE)
plot(thenetwork)
Динамический объект
head(PHDynamicNodes)
| onset | terminus | vertex.id | onset.censored | terminus.censored | duration |
|---|---|---|---|---|---|
| 1280.0 | 1311.0 | 1 | FALSE | FALSE | 31.0 |
| 1288.5 | 1311.0 | 2 | FALSE | FALSE | 22.5 |
| 1257.5 | 1290.0 | 3 | FALSE | FALSE | 32.5 |
| 1280.0 | 1305.0 | 4 | FALSE | FALSE | 25.0 |
| 1272.5 | 1282.5 | 5 | FALSE | FALSE | 10.0 |
| 1272.5 | 1305.0 | 6 | FALSE | FALSE | 32.5 |
head(PHDynamicEdges)
| onset | terminus | tail | head | onset.censored | terminus.censored | duration | edge.id |
|---|---|---|---|---|---|---|---|
| 1300 | 1301 | 10 | 11 | FALSE | FALSE | 1 | 1 |
| 1300 | 1301 | 10 | 12 | FALSE | FALSE | 1 | 2 |
| 1320 | 1321 | 10 | 30 | FALSE | FALSE | 1 | 3 |
| 1320 | 1321 | 10 | 31 | FALSE | FALSE | 1 | 4 |
| 1310 | 1311 | 11 | 12 | FALSE | FALSE | 1 | 5 |
| 1300 | 1301 | 11 | 12 | FALSE | FALSE | 1 | 5 |
dynamicCollabs = networkDynamic(
thenetwork,
edge.spells = PHDynamicEdges,
vertex.spells = PHDynamicNodes
)
## Edge activity in base.net was ignored
## Created net.obs.period to describe network
## Network observation period info:
## Number of observation spells: 1
## Maximal time range observed: 1257.5 until 1325
## Temporal mode: continuous
## Time unit: unknown
## Suggested time increment: NA
Проверка сети
network.dynamic.check(dynamicCollabs)
## $vertex.checks
## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [106] TRUE
##
## $edge.checks
## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [106] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [121] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [136] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [151] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [166] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [181] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [196] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [211] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##
## $dyad.checks
## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [106] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [121] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [136] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [151] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [166] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [181] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [196] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [211] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##
## $vertex.tea.checks
## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [106] TRUE
##
## $edge.tea.checks
## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [16] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [31] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [46] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [61] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [76] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [91] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [106] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [121] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [136] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [151] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [166] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [181] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [196] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [211] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
##
## $network.tea.checks
## [1] TRUE
##
## $net.obs.period.check
## [1] TRUE
Визуализация сети
Статика (по умолчанию)
plot(dynamicCollabs)
Всё точно так же, как и было со статичной сетью. Или нет? Почему?
Временные срезы
dynamicSimple = dynamicCollabs
dynamicSimple %n% "multiple" = FALSE
filmstrip(dynamicSimple, displaylabels = F,
frames = 9)
## No coordinate information found in network, running compute.animation
Описание динамики сетей
Формирование связей
plot(tEdgeFormation(dynamicCollabs, time.interval = .25))
Централизация сети
dynamicBetweenness = tSnaStats(
dynamicCollabs,
snafun = "centralization",
start = 1260,
end = 1320,
time.interval = 1,
aggregate.dur = 20,
FUN = "betweenness"
)
Визуализация с помощью ggplot2
library(tibble)
library(ggplot2)
df_bet = tibble(
time = as.numeric(time(dynamicBetweenness)),
value = as.numeric(dynamicBetweenness)
)
ggplot(df_bet, aes(x = time, y = value)) +
geom_line(linewidth = 0.5) +
geom_point(size = 1.5) +
labs(
x = "Time",
y = "Betweenness Centralization",
title = "Dynamic Betweenness Centralization"
) +
theme_minimal()
Пути во времени
v106path = tPath(dynamicCollabs, v = 106, start = 1260, direction = "fwd", end = 1290)
print(v106path)
## $tdist
## [1] 25.0 25.0 12.5 12.5 12.5 17.5 12.5 12.5 20.0 20.0 Inf 15.0 Inf 12.5 Inf
## [16] 25.0 12.5 12.5 12.5 Inf 12.5 15.0 12.5 17.5 Inf Inf 12.0 12.5 12.0 12.0
## [31] 12.5 12.5 15.0 15.0 12.0 12.5 12.5 12.5 12.5 20.0 20.0 12.5 12.5 12.0 15.0
## [46] 12.5 Inf 29.0 19.5 12.5 12.5 17.5 19.5 12.5 12.5 17.5 12.5 12.5 0.0 25.0
## [61] 25.0 25.0 12.5 17.5 17.5 12.5 12.5 12.5 20.0 20.0 Inf Inf Inf 15.0 15.0
## [76] 12.5 Inf 12.5 12.5 12.5 12.5 15.0 12.5 17.5 12.0 12.0 12.5 12.0 12.5 12.5
## [91] 15.0 15.0 12.0 12.5 12.5 20.0 12.5 15.0 Inf 12.5 12.5 25.0 19.5 12.5 12.5
## [106] 0.0
##
## $previous
## [1] 50 60 7 5 23 5 8 46 8 9 0 75 0 3 0 1 31 3
## [19] 38 0 28 74 17 52 0 0 85 37 30 35 3 31 34 35 86 43
## [37] 39 31 17 41 8 44 44 86 98 43 0 49 53 23 7 56 52 39
## [55] 46 64 58 54 106 1 1 2 5 6 6 8 8 8 9 10 0 0
## [73] 0 12 33 14 0 14 17 18 19 22 23 24 106 27 23 29 31 32
## [91] 33 34 35 38 39 41 42 58 0 46 51 53 53 54 57 0
##
## $gsteps
## [1] 14 16 9 14 13 14 8 7 8 9 Inf 8 Inf 10 Inf 15 11 10
## [19] 12 Inf 15 10 12 18 Inf Inf 2 14 6 5 10 11 6 5 4 6
## [37] 13 11 12 9 8 5 5 4 16 6 Inf 20 19 13 9 17 18 13
## [55] 7 16 15 14 1 15 15 17 14 15 15 8 8 8 9 10 Inf Inf
## [73] Inf 9 7 11 Inf 11 12 11 13 11 13 19 1 3 13 7 11 12
## [91] 7 6 5 12 13 9 6 15 Inf 7 10 19 19 14 16 0
##
## $start
## [1] 1260
##
## $end
## [1] 1290
##
## $direction
## [1] "fwd"
##
## $type
## [1] "earliest.arrive"
##
## attr(,"class")
## [1] "tPath" "list"
Общая визуализация
coords = plot(dynamicCollabs,
displaylabels = TRUE,
label.cex = 0.8,
label.pos = 5,
vertex.col = 'white',
vertex.cex = 3,
edge.label.col = 'blue',
edge.label.cex = 0.7
)
Визуализация путей вперёд во времени
plot(v106path, coord = coords, displaylabels = TRUE)
Пересекаются ли сети для разных узлов?
Получим корректные индексы для лейблов “10” и “106”
vertex_names = network.vertex.names(dynamicCollabs)
v10_idx = which(vertex_names == "10")
v106_idx = which(vertex_names == "106")
cat("Index of vertex labeled '10':", v10_idx, "\n")
## Index of vertex labeled '10': 1
cat("Index of vertex labeled '106':", v106_idx, "\n")
## Index of vertex labeled '106': 102
Создадим пути с корректными индексами
v10path = tPath(dynamicCollabs, v = v10_idx, start = 1260, direction = "fwd", end = 1290)
v106path = tPath(dynamicCollabs, v = v106_idx, start = 1260, direction = "fwd", end = 1290)
Визуализация путей на соседних графах
par(mfrow = c(1, 2))
plotPaths(dynamicCollabs, v10path, coord = coords,
vertex.col = ifelse(1:network.size(dynamicCollabs) == v10_idx, "red",
ifelse(is.finite(v10path$tdist), "pink", "lightgray")),
vertex.cex = ifelse(1:network.size(dynamicCollabs) == v10_idx, 3, 1.5),
displaylabels = TRUE,
label.cex = 0.6,
main = 'Paths from vertex "10" (RED source)')
plotPaths(dynamicCollabs, v106path, coord = coords,
vertex.col = ifelse(1:network.size(dynamicCollabs) == v106_idx, "blue",
ifelse(is.finite(v106path$tdist), "lightblue", "lightgray")),
vertex.cex = ifelse(1:network.size(dynamicCollabs) == v106_idx, 3, 1.5),
displaylabels = TRUE,
label.cex = 0.6,
main = 'Paths from vertex "106" (BLUE source)')
Сравним на одном графике
node_colors <- case_when(
is.infinite(v10path$tdist) & is.infinite(v106path$tdist) ~ "gray",
is.infinite(v106path$tdist) & is.finite(v10path$tdist) ~ "red",
is.finite(v106path$tdist) & is.infinite(v10path$tdist) ~ "blue",
v10path$tdist < v106path$tdist ~ "orange",
v106path$tdist < v10path$tdist ~ "lightblue",
TRUE ~ "green"
)
par(mfrow = c(1, 1))
plot(dynamicCollabs, coord = coords,
vertex.col = node_colors,
vertex.cex = 1.5,
displaylabels = TRUE,
label.cex = 0.6,
main = 'Red = only "10" reaches, Blue = only "106" reaches, Orange = "10" closer')
legend("bottomright",
legend = c("Only '10' reaches", "Only '106' reaches", "'10' closer", "'106' closer", "Neither"),
fill = c("red", "blue", "orange", "lightblue", "gray"),
cex = 0.8)